# jsonpath.pl
use strict;
use warnings;

require JSON::Path;

# add local lib folder to perl library include search path
my $settings = get_settings();
push(@INC, File::Spec->catdir($settings->{'HOME_PATH'}, 'functions'));

require 'jm_functions.pl';

my $FALSE = 0;
my $TRUE  = 1;


sub helper_parse_json {
    #
    # parse JSON string to a Perl hash or array (or scalar)
    # NB. Allows comments encoded in JavaScript syntax. 
    #     Supports scalars, which is an extension to strict JSON but is supported in browsers.
    #
    my ($json_str) = @_;

    # strip out /*...*/ comments
    $json_str =~ s{/\*.*?\*/}{}gxsm;
    # strip out //... trailing comments
    $json_str =~ s{\s+//[^\n\r]*}{}gxsm;

    my $data;
    try {
         $data = JSON->new->allow_nonref->decode($json_str);
    } catch {
        my $err = $_;
        render({
            'status' => '400 Bad Request',
            'text'   => serialise_error_message('Invalid JSON: ' . $err . "\n" . $json_str),
        });
        return;
    };
    return $data;
}

sub helper_parse_json_path {
    #
    # parse JSONPath string to a JSON::Path object
    #
    my ($path_str) = @_;

    my $path_obj;
    try {
         $path_obj = JSON::Path->new($path_str);
    } catch {
        my $err = (defined $path_obj) ? $_ : 'syntax error';
        render({
            'status' => '400 Bad Request',
            'text'   => serialise_error_message('Invalid JSONPath: ' . $err . "\n" . $path_str),
        });
        return;
    };
    return $path_obj;
}

sub helper_apply_json_path {
    #
    # apply JSON::Path object to a variable, returning an array of results
    #
    my ($path_obj, $object) = @_;

    my @v;
    try {
        @v = $path_obj->values($object);    #NOTE: values() returns a LIST
    } catch {
        my $err = (scalar(@v) == 0) ? '' : $_;
        my $obj = Dumper($object);
        $obj =~ s/\$VAR1\s=\s//xsm;
        $obj =~ s/;$//xsm;
        render({
            'status' => '400 Bad Request',
            'text'   => serialise_error_message('Invalid JSONPath application: JSONPath application of path=\'' . $path_obj . "' \n to JSON value=" . $obj),
        });
        return;
    };
    return \@v;
}


sub compile_template {
    #
    #   Compile JSONPath strings inside a JSON structure to JSON::Path objects
    #   (Assumes strings starting "$." or "$[" are a JSONPath)
    #
    my ($value) = @_;
    if (!defined $value) {
        return '';
    }
    my $type = ref($value);
    if ($type eq 'HASH') {
        my @keys = keys %$value;
        my %compiled_hash = ();
        for my $key (@keys) {
            $compiled_hash{$key} = compile_template($value->{$key});
        }
        return \%compiled_hash;
    }
    if ($type eq 'ARRAY') {
        # peep at head of array to see if an embedded function: ["namespace:function", arg1,...,argN]
        my $value0_copy = $value->[0];  #copy to avoid changing numerics to strings as side-effect of eq/substr
        $value0_copy .= ''; #convert to string (even if a JSON object!)
        if (index($value0_copy, ':') > 0 && $value0_copy =~ m/^([a-z_]+)\:([a-z_][a-z_]*)$/) {
            # embedded function: ["namespace:function", arg1,...,argN]
            # so compile this to a hash of the form: 
            #   {"_pro"=>protocol, "_ns"=>namespace, "_fn"=>function, "_args"=>[arg1,...,argN], "_defer"=>[bool1,...,boolN]]
            # and ensure preloaded the library file called 'functions/<namespace>_functions.pl' (if it exists)
            # and check that the library contains a sub called 'function_<namespace>_<function>'
            my $namespace = $1;
            my $function = $2;
            my $protocol = 'LIB';   #default: assume a call to a library in /functions folder
            # compile arg1,...,argN
            my @compiled_args = ();
            for(my $i=1; $i<scalar(@$value); $i++) {
                push(@compiled_args, compile_template($value->[$i]));
            }
            # check if a sub called 'function_<namespace>_<function>' is already defined
            my $subname = 'function_' . $namespace . '_' . $function;
            if (!defined &$subname) {
                # try to preload the library file called 'functions/<namespace>_functions.pl'
                my $settings = get_settings();
                my $fname = File::Spec->catfile($settings->{'HOME_PATH'}, 'functions', $namespace, '_functions.pl');
                my $relative_fname = substr($fname, length($settings->{'HOME_PATH'}) + 1);
                debug_message("looking for $relative_fname");
                if (-f $fname) {
                    debug_message("found $relative_fname");
                    require $fname;
                    info_message("preloaded '$subname' in $relative_fname");
                }
                # check again if a sub called 'function_<namespace>_<function>' is now defined
                if (!defined &$subname) {
                    # sub not found, so check if this is a registered external REST API call
                    debug_message('looking for remote procedure call: ' . $namespace . ':' . $function);
                    my $rpc = get_rpc() || {};
                    if (exists $rpc->{$namespace . ':' . $function}) {
                        # allow compiled call through but flag protocol as REST rather than LIB
                        $protocol = 'REST';
                    }
                    else {
                        error_message("undefined embedded function '$subname' in $relative_fname");
                        return undef;
                    }
                }
            }
            # look for an optional sub defining deferred evaluation arguments for this function
            my $defersubname = 'DEFERRED_' . $namespace . '_' . $function;
            no strict 'refs';
            my $defer_args = ((defined &$defersubname) ? &$defersubname() : []);
            use strict 'refs';
            # return compiled hash representing embedded function call
            return {
                '_pro' => $protocol,
                '_ns' => $namespace,
                '_fn' => $function,
                '_args' => \@compiled_args,
                '_defer' => $defer_args,
            };
        }

        # TYPICAL CASE: ordinary array, so just compile each element
        my @compiled_array = ();
        for my $element (@$value) {
            push(@compiled_array, compile_template($element));
        }
        return \@compiled_array;
    }
    # JSONPath or literal
    my $value_copy = $value;  #copy to avoid changing numerics to strings as side-effect of substr
    my $prefix = substr($value_copy, 0, 2);
    if ($prefix eq '$.' || $prefix eq '$[') {
        # compile JSONPath
        my $path_obj = helper_parse_json_path($value);
        if (performed_render()) {
            return;
        }
        return $path_obj;
    }
    # literal
    return $value;
}


use vars qw($_RPC);
sub get_rpc {
    return $_RPC;
}
sub set_rpc {
    my ($value) = @_;
    $_RPC = $value;
}


use vars qw($_Generate);
sub generate_set {
    my ($value) = @_;
    $_Generate = $value;
}
sub generate_get {
    return $_Generate;
}


use vars qw($_Context);
sub context_set {
    my ($value) = @_;
    $_Context = $value;
}
sub context_get {
    return $_Context;
}


sub evaluate_template_value {
    #
    #   Copy of compiled template $value with JSON Path expressions evaluated against $object.
    #   Optionally, merge the result into the supplied initial value (a reference to a hash or array).
    #
    my ($value, $context, $initial_value) = @_;
    if (!defined $value) {
        return '';
    }
    my $type = ref($value);
    if ($type eq 'HASH') {
        # check to see if this hash represents a compiled embedded function
        if (exists $value->{'_ns'} && exists $value->{'_fn'}) {
            # evaluate arguments now (i.e. replace JSONPath expressions and/or embedded functions with their results)
            my $args = $value->{'_args'} || [];
            my $defer_args = $value->{'_defer'} || [];
            my $ndefers = scalar(@$defer_args);
            my $evaluated_array = [];
            for(my $i=0; $i < scalar(@$args); $i++) {
                push(@$evaluated_array, 
                     (  ($i < $ndefers && $defer_args->[$i])
                         ?  $args->[$i]  #i.e. defer evaluation
                         :  evaluate_template_value($args->[$i], $context)
                     )
                );
            }
            my $protocol = $value->{'_pro'};
            if ($protocol eq 'LIB') {
                # call function in functions/<namespace>_functions.pl library
                my $subname = 'function_' . $value->{'_ns'} . '_' . $value->{'_fn'};
                no strict 'refs';
                my $ret = &$subname(@$evaluated_array);
                use strict 'refs';
                return $ret;
            }
            elsif ($protocol eq 'REST') {
                unshift(@$evaluated_array, $$value->{'_ns'} . ':' . $value->{'_fn'});
                return function_jm_rpc(@$evaluated_array);
            }
            # failsafe: unknown protocol (should never happen!)
            return undef;
        }

        # TYPICAL CASE: ordinary hash, so construct a hash
        my @keys = keys %$value;
        my $evaluated_hash = $initial_value || {};
        for my $key (@keys) {
            $evaluated_hash->{$key} = evaluate_template_value($value->{$key}, $context);
        }
        return $evaluated_hash;
    }
    elsif ($type eq 'ARRAY') {
        # # construct an array or apply function (car) to arguments (cdr) in a Lisp style
        # my $value0_copy = $value->[0];  #copy to avoid changing numerics to strings as side-effect of eq/substr
        # $value0_copy .= ''; #convert to string (even if a JSON object)
        # my $evaluated_array = $initial_value || [];
        # if (substr($value0_copy, 0, 3) eq 'jm:') {
        #     # apply function (car) to arguments (cdr)
        #     my $fn = 'helper_fn_' . substr($value0_copy, 3);
        #     # for certain functions, defer evaluation of compiled JSONPath expressions
        #     if ($value0_copy eq 'jm:project' || $value0_copy eq 'jm:apply') {
        #         if (scalar(@$value) != 3) {     #arity 2
        #             return undef;
        #         }
        #         # do not evaluate first argument here
        #         push(@$evaluated_array, $value->[1]);   # defer evaluation of template
        #         push(@$evaluated_array, evaluate_template_value($value->[2], $context));
        #     }
        #     elsif ($value0_copy eq 'jm:generate') {
        #         if (scalar(@$value) < 3) {     #arity 2 or 3
        #             return undef;
        #         }
        #         # do not evaluate first or third arguments here
        #         push(@$evaluated_array, $value->[1]);   # defer evaluation of template
        #         push(@$evaluated_array, evaluate_template_value($value->[2], $context));
        #         push(@$evaluated_array, $value->[3]);   # defer evaluation of options
        #     }
        #     else {
        #         # evaluate arguments now (i.e. replace JSONPath expressions with their results)
        #         for(my $i=1; $i < scalar(@$value); $i++) {
        #             push(@$evaluated_array, evaluate_template_value($value->[$i], $context));
        #         }
        #     }
        #     # evaluate of function, from fn_helpers.pl
        #     no strict 'refs';
        #     my $ret = &$fn(@$evaluated_array);
        #     use strict 'refs';
        #     return $ret;
        # }
        # if (index($value0_copy, ':') > 0 && $value0_copy =~ m/^[a-z_\-]+\:[a-z_][a-z_\-]*$/) {
        #     # apply namespace:function (car) to arguments (cdr) via an external REST call
        #     my ($rpc_name) = ($value0_copy =~ m/^([a-z_\-]+\:[a-z_][a-z_\-]*)$/);
        #     push(@$evaluated_array, $rpc_name);
        #     # evaluate arguments now (i.e. replace JSONPath expressions with their results)
        #     for(my $i=1; $i < scalar(@$value); $i++) {
        #         push(@$evaluated_array, evaluate_template_value($value->[$i], $context));
        #     }
        #     my $ret = helper_fn_rpc(@$evaluated_array);
        #     return $ret;
        # }
        # else {
            # construct an array
            my $evaluated_array = $initial_value || [];
            for my $element (@$value) {
                push(@$evaluated_array, evaluate_template_value($element, $context));
            }
            return $evaluated_array;
        # }
    }
    elsif ($type eq 'JSON::Path') {
        # replace compiled JSON Path with result of its application to $context
        my $v = helper_apply_json_path($value, $context);
        if (performed_render()) {
            return;
        }
        if (scalar(@$v) == 0) {
            return undef;
        }
        #FIXME: is this sensible? Means you can't return a result that is a singleton array (maybe?)
        if (scalar(@$v) == 1) {
            return $v->[0];
        }
        return $v;
        #FIXME: could return a basic default term of s_0 dependant upon the expected result type
    }
    return $value;
}

1;
